#!/usr/bin/perl
# file: ftp_mirror.pl

use strict;
use Net::FTP;
use File::Path;                 # 提供mkpath例程创建具有所有中间父目录和子目录
use Getopt::Long;               # 提供管理命令行参数的函数


#处理命令行参数
use constant USAGEMSG => <<USAGE;
Usage: ftp_mirror.pl [options] host:/path/to/directory
Options:
        --user  <user>   Login name
        --pass  <pass>   Password
        --hash          Progress reports
        --verbose       Verbose messages
USAGE
my ($USERNAME, $PASS, $VERBOSE, $HASH);
die USAGEMSG unless GetOptions('user=s' => \$USERNAME,
                                'pass=s' => \$PASS,
                                'hash' => \$HASH,
                                'verbose' => \$VERBOSE);
die USAGEMSG unless my ($HOST, $PATH) = $ARGV[0] =~/(.+):(.+)/;

#初始化ftp连接
my $ftp = Net::FTP->new($HOST) or die "Can't connect: $@\n";
$ftp->login($USERNAME, $PASS) or die "Can't login: ", $ftp->message;
$ftp->binary;           #传输类型设为二进制，如果想精确镜像远程站点必须这样！！
$ftp->hash(1) if $HASH; 

do_mirror($PATH);
$ftp->quit;

exit 0;

# top-level entry point for mirroring.
sub do_mirror{
        my $path = shift;
        return unless my $type = find_type($path);
        my ($prefix, $leaf) = $path =~m!^(.*?)([^/]+)/?$!;
        print "prefix $prefix, leaf $leaf, type is $type\n" if $VERBOSE;
        $ftp->cwd($prefix) if $prefix;
        return get_file($leaf) if $type eq '-'; #ordinary file

        return get_dir($leaf) if $type eq 'd';
        warn "Don't know what to do with a file of type $type Skipping .";
}

#mirror_file
sub get_file{
        my ($path, $mode) = @_;
        my $rtime = $ftp->mdtm($path);          # 获取远程文件的修改时间
        my $rsize = $ftp->size($path);          # 获取远程文件的长度
        $mode = (parse_listing($ftp->dir($path)))[2] unless defined $mode;
        my ($lsize, $ltime) = stat($path)? (stat(_))[7,9]:(0,0);
        # stat 获取本地文件的修改大小和修改时间。
        if(defined($rtime) and defined($rsize)
                and ($ltime >= $rtime)
                and ($lsize == $rsize)){
                warn "Getting file $path: not never than local copy.\n" if $VERBOSE;
                return;
        }
        warn "Getting file $path\n" if $VERBOSE;
        $ftp->get($path) or (warn $ftp->message, "\n" and return);
        chmod $mode, $path if $mode;
}


#mirror a directory, recursively
=pod
 递归目录镜像；
 拷贝目录内部嵌套的目录，必须递归调用本身。
=cut
sub get_dir{
        my($path, $mode) = @_;
        my $localpath = $path;
        -d $localpath or mkpath $localpath or die "mkpath failed: $!";
        # -d 判断目录是否存在，否则创建目录；
        chdir $localpath or die "Can't chdir to $localpath: $!";
        # 进入该目录；
        chmod $mode, "." if $mode;
        my $cwd = $ftp->pwd or die "Can't pwd: ", $ftp->message;
        #保存当前的ftp路径，以便遍历目录结束后返回。
        $ftp->cwd($path) or die "Can't cwd: ", $ftp->message;
        #进入目的目录。

        warn "Getting directory $path \n" if $VERBOSE;

        foreach($ftp->dir){
                next unless my($type, $name, $mode) = parse_listing($_);
                next if $name =~/^(\.|\.\.)$/; # skip . and ..
                get_dir($name, $mode)   if $type eq 'd';
                get_file($name, $mode)  if $type eq '-';
                make_link($name)        if $type eq 'l';
        }
        $ftp->cwd($cwd) or die "Can't cwd: ", $ftp->message;
        chdir '..';
}

#subroutine to detemine whether a path is a directory or a file
=pod
这是一个未完全实现的子例程。
用来给出文件或目录的路径情况下cancel文件或目录类型。
替代的可以使用 cwd 检测该路径是否是一个目录。如果 cwd 失败则是一个文件；否则假定是一个目录。
但是根据这个原则，连接则被处理成文件或者是目录。
=cut
sub find_type{
        my $path = shift;
        my $pwd = $ftp->pwd;
        my $type = '-';         # assume plain file
        if($ftp->cwd($path)){
                $ftp->cwd($pwd);
                $type = 'd';
        }
        return $type;
}

# Attempt to mirror a link. Only works on relative targets.
sub make_link{
        my $entry = shift;
        my ($link, $target) = split /\s+->\s+/,$entry;
        return if $target =~ m!^/!;
        warn "Symlinking $link -> $target\n" if $VERBOSE;
        return symlink $target, $link;
#symlink 内置函数，只有指向相对目标的符号链接才被创建。
#该绝对路径可能在本地机器上不能用，而且还是个安全问题。
}

#parse directory listings
# -rw-r--r--    1       root    root    312     Aug     1       1994    welcome.msg
sub parse_listing{
        my $listing = shift;
        my ($type, $mode, $name);
        # return unless my ($type, $mode, $name) = 
        my ($type, $mode, $name) =
        ($listing =~ /^([-a-z])
                ([a-z-]{9})
                \s+\d*
                (?:\s+[\w-]+){2}
                \s+\d+
                \s+\w+\s+\d+\s+[\d:]+
                \s+(.+)
                $/x);
        # if($listing =~ m/^([a-z-]) ([a-z-]{9})  \s+\d*  (?:\s+\w+){2} \s+\d+      \s+\w+\s+\d+\s+[\d:]+ \s+(.+) $/x){
        #         print "matched $1 $2 $3 \n";
        # }
        # print "list is $listing\n";
        # $listing =~ m/^([a-z-])([a-z-]{9})\s+\d*(?:\s+\w+){2}\s+\d+\s+\w+\s+\d+\s+[\d:]+\s+(.+)$/x;
        # print "ytpe ", $type, "name ", $name,"mode ", filemode($mode), "\n\n";
        return ($type, $name, filemode($mode));
}

#turn symbolic modes into octal
sub filemode{
        my $symbolic = shift;
        my (@modes) = $symbolic =~/(...)(...)(...)$/g;
        # foreach (@modes){
        #         print $_,"\n";
        # }
        my $result;
        my $multipilier = 1;
        while(my $mode = pop @modes){
                my $m = 0;
                $m += 1 if $mode =~ /x/;
                $m += 2 if $mode =~ /w/;
                $m += 4 if $mode =~ /r/;
                $result += $m * $multipilier if $m > 0;
                $multipilier *= 8;
        }
        $result;
}